//	COPYRIGHT (C) 1980 BY BOARD OF TRUSTEES,
//	LELAND STANFORD JUNIOR UNIVERSITY

GET "BCPLIB.GET[1,35]"
GET "MYLIB.GET[1,35]"
GET "LINSTR.BCL[1,35]"
MANIFEST $( ALLON=-1 $)
MANIFEST $( ALLBUTONEON=-2 $)
MANIFEST $( P2WDSZ=5 $)
MANIFEST  $( R2WDSZ=32 $)
STATIC $( SGROUP=NIL; CTABLE=NIL; CTSTART=NIL; CTSTOP=NIL; ATTYPE=NIL; $)
STATIC $( NHYD=NIL; GPTOOLG=0;  $)
GET "GPRCAN.BCL[1,35]"

STATIC $( NEWNUM=NIL; OLDNUM=NIL; RENCHK=0; LPYET=0; ADJCHK=0; POSADJ=NIL; $)
STATIC $( P=NIL; NUMBAT=NIL; CT=NIL; PERM=NIL; I=NIL; J=NIL; K=NIL;
            TOTALCOUNT=0; NEXTNUMBAT=0; STRUCNUM=NIL; INDEX=NIL; $)
STATIC  $( BD=NIL; ATYPSTK=NIL; $)
STATIC  $( NDBS=NIL; INVGEN=NIL; REVSCT=NIL; DINVGEN=NIL; MMINVGEN=NIL;
             RDBINV=NIL; DBINV=NIL; IPERM=NIL; IMAGE=NIL; AFTER=NIL; BEFORE=NIL;
             PAR=NIL; KCSG=NIL; INV=NIL; STPRMINDEX=NIL; STPRMORDER=NIL;
             STPRM=NIL; DBINDEX=NIL; REDINV=NIL;  $)
STATIC $( Y=NIL; SW=NIL; BRND=NIL; J1=NIL; K1=NIL;  ORBIT=NIL; CPERM=NIL;
      M=NIL;  KS=NIL;  P2=NIL; M2=NIL;  P1=NIL; M1=NIL;
           D=NIL;  CTB=NIL; PCOUNT=NIL; DOT=NIL; NRJ=NIL; NDB=NIL;
           NDBAT=NIL; NST=NIL; SCT=NIL; DBCT=NIL; AT=NIL; Q=NIL; $)
STATIC $( STMIN=NIL; STMAX=NIL; REV=NIL; MAXISOM=NIL; G=NIL; GPSTR=NIL;
              ISOMERS=NIL;  NEQCL=NIL; GENCONSTR=NIL; MOST=NIL;
              SKIP=NIL; W=NIL; LARGEST.SO.FAR=NIL; ENANTIOMER=NIL; STM=NIL;
              WP=NIL; B=NIL; C=NIL; T=NIL; H=NIL; ENAN=NIL; $)
STATIC $( POLYACOEF=NIL; STEREOCOUNT=NIL; OLDSUM=NIL; NUMORBS=NIL;
            A=NIL; REFLCHKSUM=NIL; POLYASUM=NIL; PRODPERM=NIL; ORB=NIL;
            PERMTOSTPRM=NIL; REFLCHK=NIL; ORBCOUNT=NIL; SUM=NIL;  $)
STATIC $( INQ=NIL; ISO=NIL; CENT=NIL; CNTF=NIL; CNTB=NIL; FOUND=NIL; $)
STATIC $( INVTST=NIL; CHN=NIL; TOPR=NIL; BOTR=NIL; CHLN=NIL; CHNPAR=NIL;
           TEMPGROUP=NIL;  CHNDR=NIL; $)

STATIC $( VECSPACE = VEC 6000 $)
LET TOPSTK(STR1) BE
$( LET TX=NEWVEC(0)
   OUTS(STR1)
   OUTNO(TX)
   FREEVEC(TX)
$)

LET GETCTANDGROUP() BE
$(D STATIC $( NDNOS=NIL; 
              CH=NIL; PCTSTART=NIL; PCTSTOP=NIL; $)
STATIC $( PROGR=NIL; BCHK=NIL; PATTYPE=NIL;  INPATYP=NIL; $)
STATIC $(  ATPTR=NIL; $)

LET BUILDATTYPE(IAT) BE
$(
   PROGR:=1
$( BCHK:=0
   FOR IB=1 TO 3 DO
   IF (ATYPSTK!(3*(PROGR-1)+IB) NE INPATYP!IB)
   DO BCHK:=1
   TEST (BCHK=1)
   THEN TEST (PROGR>ATPTR)
        THEN
        $( FOR IB=1 TO 3 DO
           ATYPSTK!(3*(PROGR-1)+IB):=INPATYP!IB
           ATPTR:=ATPTR+1
        $)
        OR PROGR:=PROGR+1
   OR PATTYPE!IAT:=PROGR
$) REPEATUNTIL (PATTYPE!IAT NE 0)
$)
ST1: TEST (NEXTNUMBAT LE 0) THEN  NUMBAT:=INNO()
OR NUMBAT:=NEXTNUMBAT
IF (NUMBAT<0) DO
   GOTO ST1
CT:=NEWVEC(5*NUMBAT)
NHYD:=NEWVEC(NUMBAT)
ATTYPE:=NEWVEC(NUMBAT)
ATYPSTK:=NEWVEC(3*NUMBAT)
CTABLE:=NEWVEC(5*NUMBAT)
FOR I=0 TO 5*NUMBAT DO
$( CT!I:=0
   CTABLE!I:=0
$)
CTSTART:=NEWVEC(NUMBAT)
CTSTOP:=NEWVEC(NUMBAT)
INPATYP:=NEWVEC(3)
FOR I=0 TO 3*NUMBAT DO
ATYPSTK!I:=0
NDNOS:=NEWVEC(NUMBAT)
PATTYPE:=NEWVEC(NUMBAT)
FOR I=0 TO NUMBAT DO PATTYPE!I:=0
PCTSTART:=NEWVEC(NUMBAT)
PCTSTOP:=NEWVEC(NUMBAT)
INDEX:=1
ATPTR:=0
ST2:  FOR I=1 TO NUMBAT DO
$( CTABLE!INDEX:=INNO()
   PCTSTART!I:=INDEX
   INDEX:=INDEX+1
   FOR J=1 TO 3 DO
   INPATYP!J:=INCH()
   BUILDATTYPE(I)
   $( CTABLE!INDEX:=INNO()
      INDEX:=INDEX+1
   $) REPEATUNTIL (INCH()='*C')
   PCTSTOP!I:=INDEX-1
   IF (((PCTSTOP!I)-(PCTSTART!I))>4) DO
   $( NEWLINE(1)
      OUTS("ATOM NUMBER ")
      OUTNO(CTABLE!(PCTSTART!I))
      OUTS(" HAS VALENCE GREATER THAN 4,")
      NEWLINE(1)
      OUTS("STEREOISOMER GENERATION CANNOT CONTINUE")
      NEWLINE(1)
      GPTOOLG:=1
      ENDREAD(INPUT)
      GOTO FAIL
   $)
$)
$( CH:=INCH()
   IF (CH='#') DO STRUCNUM:=INNO()  $) REPEATUNTIL (CH='$')
FOR I=1 TO NUMBAT DO
IF CTABLE!(PCTSTART!I)>NUMBAT DO RENCHK:=1
IF RENCHK=1 DO
$( OLDNUM:=NEWVEC(NUMBAT)
   FOR I=1 TO NUMBAT DO OLDNUM!I:=CTABLE!(PCTSTART!I)
   FOR I=1 TO NUMBAT DO
   FOR J=1 TO INDEX DO
   IF (CTABLE!J=OLDNUM!I) DO
   CTABLE!J:=-(NUMBAT-I+1)
   FOR I=1 TO INDEX DO
   CTABLE!I:=-(CTABLE!I)
   NEWLINE(1)
   OUTS("NOTE: ATOM RENUMBERING WAS NECESSARY")
   FOR I=1 TO NUMBAT DO
   $( IF ((I REM 4)=1) DO NEWLINE(1)
      OUTS("  ")
      OUTNO(OLDNUM!I)
      OUTS(" IS NOW ")
      NEWNUM:=(NUMBAT-I+1)
      OUTNO(NEWNUM)
   $)
   FREEVEC(OLDNUM)
$)
FOR I=1 TO NUMBAT DO
$( CTSTART!(CTABLE!(PCTSTART!I)):=(PCTSTART!I)+1
   CTSTOP!(CTABLE!(PCTSTART!I)):=PCTSTOP!I
$)
FOR I=1 TO NUMBAT DO
$( CT!(5*(I-1)+1):=I
   FOR J=2 TO ((CTSTOP!I)-(CTSTART!I)+2) DO
   CT!(5*(I-1)+J):=CTABLE!((CTSTART!I)+J-2)
   ATTYPE!(CTABLE!(PCTSTART!I)):=PATTYPE!I
   NHYD!I:=0
   NDNOS!I:=I
$)
FOR I=1 TO NUMBAT DO
FOR J=2 TO 5 DO
IF (CT!(5*(I-1)+J)=0) DO
NHYD!I:=1+NHYD!I
NEXTNUMBAT:=INNO()
FREEVEC(PCTSTOP)
FREEVEC(PCTSTART)
FREEVEC(PATTYPE)
TEMPGROUP:=NEWVEC(2000)
TEMPGROUP!0:=2000
SGROUP:=GROUPORCANON(1,NUMBAT,NDNOS,NUMBAT,NHYD,NHYD,TEMPGROUP)
IF (SGROUP=0) DO
$( OUTS("GROUP TOO LARGE, CANNOT CONTINUE")
   ENDREAD(INPUT)
   GPTOOLG:=1
   GOTO FAIL
$)
P:=(SGROUP!0)+1
FREEVEC(TEMPGROUP)
PERM:=NEWVEC(P*NUMBAT)
FOR I=1 TO NUMBAT DO
PERM!I:=I
FOR I=1 TO P-1 DO
FOR J=1 TO NUMBAT DO
PERM!((NUMBAT*I)+J):=SGROUP!(NUMBAT*(I-1)+I+J)
FREEVEC(SGROUP)
FREEVEC(NDNOS)
FREEVEC(INPATYP)
FREEVEC(CTSTOP)
FREEVEC(CTSTART)
FREEVEC(CTABLE)
FAIL:
$)D
LET GENERATE() BE
$(D
STATIC $( AF=NIL; BF=NIL; CF=NIL; DF=NIL $)
STATIC $( MC=NIL;  MBCT=NIL; CYC.ALL.CHK=NIL; NS=NIL $)
STATIC $( CTF=NIL; INWDSZ=NIL; CUMULENE=NIL; A=NIL;  END.OF.CUMULENE=NIL $)
STATIC $( NEXT.NODE=NIL; LENGTH=NIL $)
STATIC $(  EQCLSC=NIL; MULTEDG=NIL; CMROW=NIL; $)

STATIC $( X=NIL;  EXTRA=NIL; PROD=NIL; $)


LET MIN.MAX(XM) BE
$( STATIC $( JJ=NIL;  $)
   STMIN:=XM
   STMAX:=XM
   FOR JJ=1 TO NDB/2 DO
   $( STMIN:=(STMIN < (STMIN NEQV MMINVGEN!JJ) ->
              STMIN , (STMIN NEQV MMINVGEN!JJ))
      STMAX:=(STMAX > (STMAX NEQV MMINVGEN!JJ) ->
              STMAX , (STMAX NEQV MMINVGEN!JJ))
  $)
$)
LET INVERT(YI) = VALOF
$( 
   STATIC $( XI=NIL; $)
   XI:= (1<<(NST+NDBAT))-1
   REV:=XI NEQV YI
   RESULTIS(REV)
$)
LET FLAG(NODE,BIT) = VALOF
$( AF:=BIT/R2WDSZ
   BF:=BIT REM R2WDSZ
   CF:=CTF!(((NODE-1)*INWDSZ)+1+AF)
   DF:=(CF>>BF) BITAND 1
   RESULTIS DF
$)
LET TURN.ON.FLAG(NODE,BIT) BE
$( IF FLAG(NODE,BIT)=0 DO
   CTF!(((NODE-1)*INWDSZ)+1+AF):= CF + (1<<BF)
$) 

LET TURN.OFF.FLAG(NODE,BIT) BE
$( IF FLAG(NODE,BIT) NE 0
   DO CTF!(((NODE-1)*INWDSZ)+1+AF):=CF-(1<<BF)
$) 


LET FIND.CUMULENE(NODE) BE
$( CUMULENE!1:=NODE
   NEXT.NODE:=MULTEDG!(2*(NODE-1)+1)
   LENGTH:=2
   IF EQCLSC!NEXT.NODE=4 DO
   UNTIL EQCLSC!NEXT.NODE=2 DO
   $( CUMULENE!LENGTH:=NEXT.NODE
      NEXT.NODE:=MULTEDG!(2*(NEXT.NODE-1)+1)+MULTEDG!(2*(NEXT.NODE-1)+2)-CUMULENE!(LENGTH-1);
      LENGTH:=LENGTH+1
   $)
   CUMULENE!LENGTH:=NEXT.NODE
$)

LET LABEL.EDGES.AND.ADD.ROWS(ATOM1,ATOM2) BE
$( STATIC  $( KL=NIL $) 
   FOR KL=2 TO 5 DO
   IF MBCT!(5*(ATOM1-1)+KL)=ATOM2 DO
   $( MBCT!(5*(ATOM1-1)+KL):=NS+1
      NS:=NS+1
   $)
   NS:=NS-2
   FOR KL=2 TO 5 DO
   IF MBCT!(5*(ATOM2-1)+KL)=ATOM1 DO
   $( MBCT!(5*(ATOM2-1)+KL):=NS+1
      NS:=NS+1
   $)
   MBCT!(5*(NS-2)+1):=NS-1
   MBCT!(5*(NS-2)+2):=ATOM1
   MBCT!(5*(NS-2)+3):=ATOM2
   MBCT!(5*(NS-1)+1):=NS
   MBCT!(5*(NS-1)+2):=ATOM1
   MBCT!(5*(NS-1)+3):=ATOM2
   TURN.ON.FLAG(NS-1,0)
   TURN.ON.FLAG(NS-1,12)
   TURN.ON.FLAG(NS,0)
   TURN.ON.FLAG(NS,12)
   TURN.ON.FLAG(ATOM1,14)
   TURN.ON.FLAG(ATOM2,14)
$)

LET TERMINATE(IT) BE
$( Y:= DOT!(3*(IT-1)+1)
   TURN.ON.FLAG(Y,20)
TURN.ON.FLAG(Y,0) 
   IF EQCLSC!Y=2 DO 
   $( FIND.CUMULENE(Y)
      FOR M=1 TO LENGTH DO
      TURN.ON.FLAG(CUMULENE!M,0)
   $)
   SW:=1
   FOR K=1 TO NS DO TURN.OFF.FLAG(K,1)
$)

LET STRCNSCH(BRND) = VALOF
$( STATIC $( V=NIL $)
   TURN.ON.FLAG(BRND,1)
   FOR V=2 TO 5 DO
   IF ((FLAG(MBCT!(5*(BRND-1)+V),0)=0) BITAND
       (MBCT!(5*(BRND-1)+V) NE 0) BITAND
       (FLAG(MBCT!(5*(BRND-1)+V),1)=0)) DO
   $( FOR KS=1 TO NS DO TURN.OFF.FLAG(KS,1)
      RESULTIS 0
   $)
   FOR V=2 TO 5 DO
   IF ((MBCT!(5*(BRND-1)+V) NE 0) BITAND
       (FLAG(MBCT!(5*(BRND-1)+V),0) NE 0) BITAND
       (FLAG(MBCT!(5*(BRND-1)+V),1) = 0 )) DO
   $( TURN.ON.FLAG(MBCT!(5*(BRND-1)+V),1)
      TEST (STRCNSCH(MBCT!(5*(BRND-1)+V))=1)
      THEN LOOP OR RESULTIS 0
   $)
   RESULTIS 1
$)

LET MAKE.DOT.ENTRY(I1,J1,K1) BE
   
$( IF (FLAG(J1,K1)=0) DO
    $( D:=D+1
   DOT!(3*(D-1)+1):=J1
   DOT!(3*(D-1)+2):=MBCT!(5*(J1-1)+K1)
   DOT!(3*(D-1)+3):=PERM!(NUMBAT*(I1-1)+(MBCT!(5*(J1-1)+K1)))
   TURN.ON.FLAG(J1,K1)
$) $)
LET COMPEQUIVATOMS(ISOM) BE
$( STATIC $( POSN=NIL; CINDEX=NIL; ATOM=NIL; SG=NIL; IC=NIL; JC=NIL;  $)
   FOR IC=1 TO NUMBAT DO FOUND!IC:=0
   POSN:=0
     CINDEX:=1
    $( IF ISOMERS!CINDEX=ISOM
      DO POSN:=CINDEX
      CINDEX:=CINDEX+GPSTR
   $)
   REPEATUNTIL POSN NE 0
    SG:=POSN+2
   NEWLINE(1)
   OUTS("EQUIVALENT SETS OF ATOMS:")
   NEWLINE(1)
   FOR IC=1 TO NUMBAT DO
   $(  FOR JC=1 TO STPRMORDER DO
      IF ((ISOMERS!(SG+(JC*2)/R2WDSZ) BITAND (3<<(2*(JC-1) REM R2WDSZ))) NE 0)
      DO
      $( ATOM:=PERM!((PERMTOSTPRM!JC)+(IC-1))
         IF (FOUND!ATOM=0) 
         DO
         $( IF LPYET=0 DO $( OUTS(" ("); LPYET:=1; $)
            OUTNO(ATOM)
            OUTS(" ")
         $)
         FOUND!ATOM:=1
      $)
     IF LPYET=1 DO  OUTS(") ")
      LPYET:=0
      IF ((IC REM 6)=0) DO NEWLINE(1)
   $)
$)

LET DRAWDOUBLEBOND(ISOM,ONEEND) BE
$( STATIC $( LOWEREND=NIL; ID=NIL; LOWEST=NIL; CONFIG=NIL; FLIP=NIL;
               LEFTEND=NIL; RIGHTEND=NIL; DR1=NIL; DR2=NIL; DR3=NIL;
               HIGHEREND=NIL; DR4=NIL; $)
   FIND.CUMULENE(ONEEND)
   LOWEREND:=(ONEEND<CUMULENE!LENGTH->
              ONEEND,CUMULENE!LENGTH)
   LOWEST:=LOWEREND
   FOR ID=1 TO LENGTH DO
   LOWEST:=(LOWEST<CUMULENE!ID->
            LOWEST,CUMULENE!ID)
   CONFIG:=(ISOM BITAND (1<<((REVSCT!LOWEST)-1)))
   IF CONFIG NE 0 DO CONFIG:=1
   FLIP:=0
   IF (LOWEREND NE ONEEND) DO FLIP:=1
   LEFTEND:=REVSCT!LOWEREND
   HIGHEREND:=(ONEEND>CUMULENE!LENGTH->
               ONEEND,CUMULENE!LENGTH)
   RIGHTEND:=REVSCT!HIGHEREND
   DR1:=DBCT!(3*(LEFTEND-NST-1)+2)
   DR2:=DBCT!(3*(RIGHTEND-NST-1)+3-CONFIG)
   DR3:=DBCT!(3*(LEFTEND-NST-1)+3)
   DR4:=DBCT!(3*(RIGHTEND-NST-1)+2+CONFIG)
   NEWLINE(1)
   IF ((LENGTH REM 2)=0) DO
   $( IF DR1<10 OUTS(" ")
      TEST (DR1=0)
      THEN OUTS("H")
      OR   OUTNO(DR1)
      FOR ID=1 TO 4*LENGTH-1 DO
      OUTS(" ")
      TEST (DR2=0)
      THEN OUTS("H")
      OR   OUTNO(DR2)
      NEWLINE(1)
      OUTS("  \")
      FOR ID=1 TO 4*LENGTH-3 DO
      OUTS(" ")
      OUTS("/")
      NEWLINE(1)
      OUTS("   ")
      FOR ID=1 TO LENGTH-1 DO
      $( INDEX:=(1-FLIP)*ID+FLIP*(LENGTH+1-ID)
      IF (ID>1) DO OUTS("=")
         OUTNO(CUMULENE!INDEX)
         IF CUMULENE!(INDEX)<10 DO OUTS("=")
         OUTS("=")
      $)
      IF (CUMULENE!(FLIP+(1-FLIP)*LENGTH)<10) DO OUTS("=")
      OUTNO(CUMULENE!(FLIP+(1-FLIP)*LENGTH))
      NEWLINE(1)
      OUTS("  /")
      FOR ID=1 TO 4*LENGTH-3 DO OUTS(" ")
      OUTS("\")
      NEWLINE(1)
      IF (DR3<10) OUTS(" ")
      TEST (DR3=0) 
      THEN OUTS("H")
      OR   OUTNO(DR3)
      FOR ID=1 TO 4*LENGTH-1 DO
      OUTS(" ")
      TEST (DR4=0)
      THEN OUTS("H")
      OR   OUTNO(DR4)
   $)
   IF ((LENGTH REM 2)=1) DO
   $( NEWLINE(1)
      OUTS("     ")
      TEST (DR2=0)
      THEN OUTS("H")
      OR   OUTNO(DR2)
      FOR ID=1 TO 2 DO
      $( NEWLINE(1)
         OUTS("     :")
      $)
      NEWLINE(1)
      IF (DR1<10) DO OUTS(" ")
      TEST (DR1=0)
      THEN OUTS("H")
      OR OUTNO(DR1)
      OUTS(">>>")
      OUTNO(LOWEREND)
      OUTS("<<<")
      TEST (DR3=0)
      THEN OUTS("H")
      OR   OUTNO(DR3)
      FOR ID=1 TO 2 DO
      $( NEWLINE(1)
         OUTS("     :")
      $)
      NEWLINE(1)
      OUTS("     ") 
      TEST (DR4=0)
      THEN OUTS("H")
      OR   OUTNO(DR4)
   $)
$)

LET DRAWSTEREOCENTER(ISOM,CEN) BE
$( STATIC $( STCENNO=NIL; CONFIG=NIL; CFGPAR=NIL; DR1=NIL; DR2=NIL; DR3=NIL;
               DR4=NIL; ID=NIL; $)
   STCENNO:=REVSCT!CEN
   CONFIG:=ISOM BITAND (1<<(STCENNO-1))
   PAR:=(((SCT!(5*(STCENNO-1)+2))-(SCT!(5*(STCENNO-1)+3)))*
         ((SCT!(5*(STCENNO-1)+2))-(SCT!(5*(STCENNO-1)+4)))*
         ((SCT!(5*(STCENNO-1)+2))-(SCT!(5*(STCENNO-1)+5)))*
         ((SCT!(5*(STCENNO-1)+3))-(SCT!(5*(STCENNO-1)+4)))*
         ((SCT!(5*(STCENNO-1)+4))-(SCT!(5*(STCENNO-1)+5)))*
         ((SCT!(5*(STCENNO-1)+3))-(SCT!(5*(STCENNO-1)+5))))

   TEST (PAR>0) THEN
      TEST (CONFIG=0) THEN
      CFGPAR:=0
      OR CFGPAR:=1
   OR TEST (CONFIG=0)
      THEN CFGPAR:=1
      OR   CFGPAR:=0
   NEWLINE(1)
   OUTS("     ")
   DR1:=SCT!(5*(STCENNO-1)+2)
   TEST (DR1=0)
   THEN OUTS("H")
   OR   OUTNO(DR1)
   FOR ID=1 TO 2 DO
   $( NEWLINE(1)
      OUTS("     :")
   $)
   NEWLINE(1)
   DR2:=SCT!(5*(STCENNO-1)+3+CFGPAR)
   IF (DR2<10) DO OUTS(" ")
   TEST (DR2=0)
   THEN OUTS("H>>>")
   OR $( OUTNO(DR2)
         OUTS(">>>")
      $)
   OUTNO(CEN)
   OUTS("<<<")
   DR3:=SCT!(5*(STCENNO-1)+4-CFGPAR)
   TEST (DR3=0)
   THEN OUTS("H")
   OR   OUTNO(DR3)
   FOR ID=1 TO 2 DO
   $( NEWLINE(1)
      OUTS("     :")
   $)
   NEWLINE(1)
   OUTS("     ")
   DR4:=SCT!(5*(STCENNO-1)+5)
   TEST (DR4=0)
   THEN OUTS("H")
   OR   OUTNO(DR4)
$)

LET TYPEOUT(BOND,ATOMNO) BE
$( TEST (ATOMNO GE 0)
THEN
$( TEST ATOMNO=0
   THEN $( OUTCH(BOND); OUTS("H") $)
   OR   TEST ATOMNO<10
        THEN
        $( OUTCH(BOND)
           OUTNO(ATOMNO)
        $)
        OR OUTNO(ATOMNO)
$)
   OR OUTS("  ")
$)

LET NEWMANPROJ(ISOM,CENF,CENB) BE
$( STATIC $( POSPARF=NIL; POSPARB=NIL; CONFIGPARF=NIL; CONFIGPARB=NIL;
               ROWPARF=NIL; ROWPARB=NIL; FINDEX=NIL; BINDEX=NIL; IN=NIL;
               DRF=NIL; DRB=NIL; CHKROWPARF=NIL; CHKROWPARB=NIL; PARF=NIL;
               PARB=NIL; F1=NIL; F2=NIL; F3=NIL; B1=NIL; B2=NIL; B3=NIL; $)
   DRF:=NEWVEC(3)
   DRB:=NEWVEC(3)
   POSPARF:=1
   POSPARB:=1
   CONFIGPARF:=1
   CONFIGPARB:=1
   ROWPARF:=1
   ROWPARB:=1
   FINDEX:=1
   BINDEX:=1
   FOR IN=2 TO 5 DO
   $( IF CENB<MBCT!(5*(CENF-1)+IN) DO POSPARF:=POSPARF*(-1)
      IF CENF<MBCT!(5*(CENB-1)+IN) DO POSPARB:=POSPARB*(-1)
      IF CENB NE MBCT!(5*(CENF-1)+IN) 
      DO
      $( DRF!FINDEX:=MBCT!(5*(CENF-1)+IN)
         FINDEX:=FINDEX+1
      $)
      IF CENF NE MBCT!(5*(CENB-1)+IN)
      DO 
      $( DRB!BINDEX:=MBCT!(5*(CENB-1)+IN)
         BINDEX:=BINDEX+1
      $)
   $)
   CHKROWPARF:=(DRF!1-DRF!2)*(DRF!1-DRF!3)*(DRF!2-DRF!3)
   CHKROWPARB:=(DRB!1-DRB!2)*(DRB!1-DRB!3)*(DRB!2-DRB!3)
   IF ((ISOM BITAND (1<<((REVSCT!CENF)-1)))=0)
   DO CONFIGPARF:=-1
   IF ((ISOM BITAND (1<<((REVSCT!CENB)-1)))=0)
   DO CONFIGPARB:=-1
   IF CHKROWPARF<0 DO ROWPARF:=-1
   IF CHKROWPARB<0 DO ROWPARB:=-1
   PARF:=POSPARF*ROWPARF*CONFIGPARF
   PARF:=(PARF+1)/2
   PARB:=POSPARB*ROWPARB*CONFIGPARB
   PARB:=(PARB+1)/2
   F1:=DRF!1
   F2:=DRF!(2+PARF)
   F3:=DRF!(3-PARF)
   B1:=DRB!1
   B2:=DRB!(2+PARB)
   B3:=DRB!(3-PARB)
   OUTS("     ")
   TYPEOUT('*S',B1)
   OUTS("               ")
   TYPEOUT('*S',B2)
   OUTS("               ")
   TYPEOUT('*S',B3)
   NEWLINE(1)
   FOR IN=1 TO 3 DO
   $( TYPEOUT('*S',F2)
      OUTS("    !   ")
      TYPEOUT('*S',F3)
      OUTS("     ")
   $)
   NEWLINE(1)
   FOR IN=1 TO 3 DO
   OUTS("  \      /       ")
   NEWLINE(1)
   FOR IN=1 TO 3 DO
   OUTS("    \  /         ")
   NEWLINE(1)
   FOR IN=1 TO 3 DO
   $( OUTS("     ")
      TYPEOUT('*S',CENF)
      OUTS("          ")
   $)
   NEWLINE(1)
   FOR IN=1 TO 3 DO
   OUTS("      !          ")
   NEWLINE(1)
   FOR IN=1 TO 3 DO
   OUTS("  /   !  \       ")
   NEWLINE(1)
   TYPEOUT('*S',B2)
   OUTS("    !   ")
   TYPEOUT('*S',B3)
   OUTS("     ")
   TYPEOUT('*S',B3)
   OUTS("    !   ")
   TYPEOUT('*S',B1)
   OUTS("     ")
   TYPEOUT('*S',B1)
   OUTS("    !   ")
   TYPEOUT('*S',B2)
   NEWLINE(1)
   FOR IN=1 TO 3 DO
   $( OUTS("     ")
      TYPEOUT('*S',F1)
      OUTS("          ")
   $)
   FREEVEC(DRF)
   FREEVEC(DRB)
$)
LET SHOWCONFIGS(ISOM) BE
$( STATIC $( ISH=NIL $)
   NEWLINE(1)
   FOR ISH=1 TO NST DO
   $( OUTNO(SCT!(5*(ISH-1)+1))
      OUTS(":")
      TEST ((ISOM BITAND (1<<(ISH-1))) = 0)
      THEN OUTS("0  ")
      OR   OUTS("1  ")
   $)
   FOR ISH=(NST+1) TO NST+NDBAT DO
      IF (FLAG(SCT!(5*(ISH-1)+1),7) = 0) DO
   $(   OUTNO(SCT!(5*(ISH-1)+1))
      OUTS(":")
      TEST ((ISOM BITAND (1<<(ISH-1)))=0)
      THEN TEST (FLAG(SCT!(5*(ISH-1)+1),9) NE 0)
           THEN OUTS("0  ")
           OR   
           $( OUTS("TRANS ")
              OUTNO(DBCT!(3*(ISH-NST-1)+3))
              OUTS(",")
OUTNO(DBCT!(3*(REVSCT!(MULTEDG!(2*(DBCT!(3*(ISH-NST-1)+1)-1)+1))-NST-1)+3))
OUTS("  ")           $)
       OR   TEST (FLAG(SCT!(5*(ISH-1)+1),9) NE 0)
            THEN OUTS("1  ")
            OR   $( OUTS("CIS ")
                 OUTNO(DBCT!(3*(ISH-NST-1)+3))
                 OUTS(",")
OUTNO(DBCT!(3*(REVSCT!(MULTEDG!(2*(DBCT!(3*(ISH-NST-1)+1)-1)+1))-NST-1)+3))
OUTS("  ")            $)
   $)
$)

LET SYMGROUPFOR(ISOM) BE
$( STATIC $( POSN=NIL; ISY=NIL; SG=NIL; SINDEX=NIL; JS=NIL; $)
   NEWLINE(1)
   FOR ISY=1 TO (NST+NDBAT) DO
   $( OUTNO(ISY)
      OUTS("= ")
      OUTNO(SCT!(5*(ISY-1)+1))
      OUTS("  ")
   $)
   POSN:=0
   SINDEX:=1
   $( IF ISOMERS!SINDEX=ISOM DO POSN:=SINDEX
      SINDEX:=SINDEX+GPSTR
   $)
   REPEATUNTIL POSN NE 0
   FOR ISY=1 TO STPRMORDER DO
   $( SG:=ISOMERS!(POSN+2+((ISY-1)*2)/R2WDSZ)
      IF ((SG BITAND (3<<(2*(ISY-1) REM R2WDSZ))) NE 0) DO
      $( NEWLINE(1)
         SINDEX:=(NST+NDBAT)*(ISY-1)
         FOR JS=1 TO (NST+NDBAT) DO
         $( OUTNO(STPRM!(SINDEX+JS))
            OUTS(" ")
         $)
         TEST ((SG BITAND (1<<(2*(ISY-1) REM R2WDSZ))) = 0)
         THEN OUTS("-1")
         OR   OUTS("+1")
      $)
   $)
$)
LET DETCHAIN(CHLEN) BE
$( STATIC $( ID=NIL; DINDEX=NIL; CHNPARCHK=NIL; $)
   FOR ID=2 TO CHLEN DO
   $( DINDEX:=1
      FOR JD=2 TO 5 DO
      IF ((CT!(5*(CHN!ID-1)+JD) NE CHN!(ID-1)) BITAND
          (CT!(5*(CHN!ID-1)+JD) NE CHN!(ID+1))) DO
      $( CHNDR!(2*(ID-1)+DINDEX):=CT!(5*(CHN!ID-1)+JD)
         DINDEX:=DINDEX+1
      $)
      IF (FLAG((CHN!ID),0)=0) DO
      TEST (FLAG((CHN!ID),14)=0) 
      THEN
      $( CHNPARCHK:= ((CHN!(ID-1)-CHN!(ID+1))*
                      (CHN!(ID-1)-CHNDR!(2*(ID-1)+2))*
                      (CHN!(ID-1)-CHNDR!(2*(ID-1)+1))*
                      (CHN!(ID+1)-CHNDR!(2*(ID-1)+2))*
                      (CHN!(ID+1)-CHNDR!(2*(ID+1)+1)))
      $)
      OR
      $( IF (MULTEDG!(2*(CHN!ID-1)+1)=CHN!(ID+1)) DO 
          CHNPARCHK:=(CHN!(ID-1)-CHNDR!(2*(ID-1)+1))
        IF (MULTEDG!(2*(CHN!ID-1)+1)=CHN!(ID-1)) DO
           CHNPARCHK:=CHNDR!(2*(ID-1)+1)-CHN!(ID+1)
      $)
      IF CHNPARCHK<0 THEN CHNPAR!ID:=-1
      IF CHNPARCHK>0 THEN CHNPAR!ID:=1
   $)
$)

LET DRAWCHAIN(ISOM,CHLEN) BE
$( STATIC $( ID=NIL; CONFIG=NIL; DRPAR=NIL; CFGPAR=NIL; $)
   FOR ID=2 TO CHLEN DO
   $( TEST (FLAG(CHN!ID,0) NE 0)
      THEN
      $( TOPR!ID:=CHNDR!(2*(ID-1)+1)
         BOTR!ID:=CHNDR!(2*(ID-1)+2)
      $)
      OR
      $(  CONFIG:=(ISOM BITAND (1<<((REVSCT!(CHN!ID))-1)))
          TEST (CONFIG>0)
          THEN CFGPAR:=1
          OR   CFGPAR:=-1
         TEST (FLAG((CHN!ID),14)=0)
         THEN
         $( TEST (CHNDR!(2*(ID-1)+1)<CHNDR!(2*(ID-1)+2))
            THEN DRPAR:=-1
            OR   DRPAR:=1
            PAR:=(CHNPAR!ID)*CFGPAR*DRPAR*(-1)
            IF PAR<0 DO PAR:=0
            TOPR!ID:=CHNDR!(2*(ID-1)+1+PAR)
            BOTR!ID:=CHNDR!(2*(ID-1)+2-PAR)
         $)
         OR
         $( PAR:=(CHNPAR!ID)*CFGPAR
            TEST (PAR<0)
            THEN
            $( TOPR!ID:=CHNDR!(2*(ID-1)+1)
               BOTR!ID:=-1
            $)
            OR
            $( TOPR!ID:=-1
               BOTR!ID:=CHNDR!(2*(ID-1)+1)
            $)
         $)
      $)
      IF (EQCLSC!(CHN!ID)>2) DO
      $( TOPR!ID:=-1
         BOTR!ID:=-1
      $)
   $)
   OUTS("  ")
   FOR ID=2 TO CHLEN-1 DO
   $( OUTS(" ")
      TYPEOUT('*S',TOPR!ID)
   $)
   NEWLINE(1)
   OUTS("  ")
   FOR ID=2 TO CHLEN-1 DO
   TEST (TOPR!ID=-1)
    THEN OUTS("   ")
    OR OUTS("  !")
   NEWLINE(1)
   BD:='*S'
   FOR ID=1 TO CHLEN-1 DO
   $( TYPEOUT(BD,CHN!ID)
      TEST ( (MULTEDG!(2*(CHN!ID-1)+1) = CHN!(ID+1)) BITAND (EQCLSC!(CHN!ID)=3) BITAND (EQCLSC!(CHN!(ID+1))=3))
      THEN $( OUTS("#"); BD:='#' $)
      OR
     TEST ((((EQCLSC!(CHN!ID)) REM 2)=0) BITAND (((EQCLSC!(CHN!(ID+1))) REM 2)=0))
     THEN TEST  ((MULTEDG!(2*(CHN!ID-1)+1) = CHN!(ID+1)) BITOR (MULTEDG!(2*(CHN!ID-1)+2) = CHN!(ID+1)))
      THEN $( OUTS("="); BD:='='; $)
      OR  $(  OUTS("-"); BD:='-'; $)
OR  $( OUTS("-"); BD:='-'; $)
   $)
   TYPEOUT(BD,CHN!CHLEN)
   NEWLINE(1)
   OUTS("  ")
   FOR ID=2 TO CHLEN-1 DO
   TEST (BOTR!ID=-1)
   THEN OUTS("   ")
   OR OUTS("  !")
   NEWLINE(1)
   OUTS("  ")
   FOR ID=2 TO CHLEN-1 DO
   $( OUTS(" ")
      TYPEOUT('*S',BOTR!ID)
   $)
$)
LET CHKISOMNUM(ISOM) = VALOF
$( FOR IC=1 TO STEREOCOUNT DO
   IF (ISOMERS!(GPSTR*(IC-1)+1)=ISOM) DO RESULTIS -1
   OUTNO(ISOM)
   OUTS(" IS NOT ONE OF THE GENERATED STEREOISOMERS.  CHOOSE ONE OF: ")
   NEWLINE(1)
   FOR IC=1 TO STEREOCOUNT DO
   $( OUTS(" ")
      OUTNO(ISOMERS!(GPSTR*(IC-1)+1))
   $)
   RESULTIS 0
$)
CUMULENE:=NEWVEC(NUMBAT)
EQCLSC:=NEWVEC(NUMBAT)
MULTEDG:=NEWVEC(2*NUMBAT)
INWDSZ:=1<<(5-P2WDSZ)
CTF:=NEWVEC(2*NUMBAT*INWDSZ)
CMROW:=NEWVEC(NUMBAT)
FOR I=0 TO (2*NUMBAT*INWDSZ) DO CTF!I:=0
EXTRA:=0
FOR I=1 TO NUMBAT DO
$(   EQCLSC!I:=0
    MULTEDG!I:=0
    MULTEDG!(I+NUMBAT):=0
$)
FOR I=0 TO NUMBAT-1 DO
$(  FOR K=1 TO NUMBAT DO
    CMROW!K:=0;
    FOR J=2 TO 5 DO
   $( X:=CT!(5*I+J)
    IF (X NE 0) DO  CMROW!X:=1+ CMROW!X
$)    PROD:=1
    INDEX:=1
    FOR J=1 TO NUMBAT DO
    $( IF CMROW!J THEN PROD:=PROD*CMROW!J
       IF CMROW!J GR 1 THEN
       $( EXTRA:=EXTRA-1+CMROW!J
          MULTEDG!(2*I+INDEX):=J
          INDEX:=INDEX+1
       $)
    $)
    EQCLSC!(I+1):=PROD
$)
FOR I=0 TO NUMBAT DO CMROW!I:=0
FREEVEC(CMROW)
MBCT:=NEWVEC(5*(NUMBAT+EXTRA+1))
FOR I=1 TO 5*(NUMBAT+EXTRA+1) DO MBCT!I:=0
FOR I=1 TO 5*NUMBAT DO
MBCT!I:=CT!I
END.OF.CUMULENE:=NEWVEC(NUMBAT)
FOR I=0 TO NUMBAT DO END.OF.CUMULENE!I:=0
CYC.ALL.CHK:=0

FOR I=1 TO NUMBAT DO
SWITCHON EQCLSC!I INTO
$( CASE 0 : TURN.ON.FLAG(I,0)
            ENDCASE
   CASE 1 : SWITCHON NHYD!I INTO
            $( CASE 2 : TURN.ON.FLAG(I,0)
                        ENDCASE
               CASE 3 : TURN.ON.FLAG(I,0)
                        ENDCASE
            $)
               ENDCASE
   CASE 2 :  IF NHYD!I=2 DO
            $( FIND.CUMULENE(I)
               FOR MC=1 TO LENGTH DO
               $( TURN.ON.FLAG((CUMULENE!MC),0)
                  TURN.ON.FLAG((CUMULENE!MC),10)
                  TURN.ON.FLAG((CUMULENE!MC),13)
               $)
            $)
            ENDCASE
   CASE 3 :  TURN.ON.FLAG(I,0)
             TURN.ON.FLAG(I,11)
            ENDCASE
   CASE 4 :  CYC.ALL.CHK:=CYC.ALL.CHK+1
            ENDCASE
$)
IF CYC.ALL.CHK=NUMBAT DO
FOR I=1 TO NUMBAT DO
$( TURN.ON.FLAG(I,0)
   TURN.ON.FLAG(I,10)
   TURN.ON.FLAG(I,13)
$)
NS:=NUMBAT

FOR I=1 TO NUMBAT DO
IF EQCLSC!I=2 DO
$( X:= (((NHYD!I=0) + (NHYD!I=1)) BITAND (FLAG(I,10)=0) BITAND
    (FLAG(MULTEDG!(2*(I-1)+1),10)=0)) 
IF X DO
$( FIND.CUMULENE(I)
   FOR A=1 TO LENGTH-1 DO
   $( LABEL.EDGES.AND.ADD.ROWS(CUMULENE!A,CUMULENE!(A+1))
      TURN.ON.FLAG(CUMULENE!A,10)
   $)
   END.OF.CUMULENE!I:=CUMULENE!LENGTH
   END.OF.CUMULENE!(CUMULENE!LENGTH):=I
   TURN.ON.FLAG(END.OF.CUMULENE!I,10)
   IF LENGTH GE 3 DO
   FOR A=1 TO LENGTH DO
   $( TURN.ON.FLAG(CUMULENE!A, 8)
      TURN.ON.FLAG(CUMULENE!A,9)
   $)
 $) $)
TURN.ON.FLAG(0,0)
FREEVEC(END.OF.CUMULENE)
DBCT:=NEWVEC(3*NUMBAT)
FOR I=0 TO (3*NUMBAT) DO DBCT!I:=0
SCT:=NEWVEC(5*NUMBAT)
FOR I=0 TO 5*NUMBAT DO SCT!I:=0
ORBIT:=NEWVEC(NUMBAT)
AT:=NEWVEC(2)
DOT:=NEWVEC(12*NUMBAT)
FOR I=0 TO (12*NUMBAT) DO DOT!I:=0

D:=0
CPERM:=NEWVEC(NUMBAT)
FOR I=0 TO NUMBAT DO CPERM!I:=0
FOR I=1 TO NUMBAT DO ORBIT!I:=I
FOR I=2 TO P DO
$( FOR J=1 TO NUMBAT DO CPERM!J:=PERM!(NUMBAT*(I-1)+J)
    FOR J=1 TO NUMBAT DO
   $( ORBIT!J:=
(ORBIT!J LE ORBIT!(PERM!((I-1)*NUMBAT +J)) -> ORBIT!J, ORBIT!(PERM!((I-1)*NUMBAT+J)))
      IF ((PERM!((I-1)*NUMBAT+J)=J) BITAND (FLAG(J,0)=0)) DO
      FOR K=2 TO 5 DO
      IF ((MBCT!(5*(J-1)+K) LE NUMBAT) BITAND (MBCT!(5*(J-1)+K) NE 0)) DO
      $( CTB:=MBCT!(5*(J-1)+K)
         PCOUNT:=0
         $( CTB:=PERM!(NUMBAT*(I-1)+CTB)
            PCOUNT:=PCOUNT+1
         $)
         REPEATUNTIL CTB=MBCT!(5*(J-1)+K) 
         SWITCHON PCOUNT INTO
         $( CASE 1: LOOP
                    ENDCASE
            CASE 2:                  P1:=NUMBAT*(I-1); M1:=5*(J-1)
                    P2:=  (((CPERM!((MBCT!(M1+2))))-
                              (CPERM!((MBCT!(M1+3)))))*
                              ((CPERM!((MBCT!(M1+2))))-
                              (CPERM!((MBCT!(M1+4)))))*
                              ((CPERM!((MBCT!(M1+2))))-
                              (CPERM!((MBCT!(M1+5)))))*
                              ((CPERM!((MBCT!(M1+3))))-
                              (CPERM!((MBCT!(M1+4)))))*
                              ((CPERM!((MBCT!(M1+3))))-
                              (CPERM!((MBCT!(M1+5)))))*
                              ((CPERM!((MBCT!(M1+4))))-
                              (CPERM!((MBCT!(M1+5))))))
                      M2:= ((MBCT!(M1+2)-MBCT!(M1+3))*(MBCT!(M1+2)-MBCT!(M1+4))*
                              (MBCT!(M1+2)-MBCT!(M1+5))*
                              (MBCT!(M1+3)-MBCT!(M1+4))*
                              (MBCT!(M1+3)-MBCT!(M1+5))*
                              (MBCT!(M1+4)-MBCT!(M1+5)))
                    IF (FLAG(J,14)=0) DO TEST (P2=M2)
                        THEN BREAK
                        OR   MAKE.DOT.ENTRY(I,J,K)
                    IF (FLAG(J,14) NE 0) DO   MAKE.DOT.ENTRY(I,J,K)
                  TURN.ON.FLAG(J,6)
                    ENDCASE
            CASE 3: TURN.ON.FLAG(J,6)
                      BREAK
                      ENDCASE
              CASE 4:  MAKE.DOT.ENTRY(I,J,K)
                      TURN.ON.FLAG(J,6)
                      BREAK
                      ENDCASE
            $)
         $)
      $)
   $)
FOR I=1 TO NUMBAT DO FOR J=2 TO 5 DO TURN.OFF.FLAG(I,J)
SW:=1
UNTIL SW=0 DO
$( SW:=0
   FOR I=1 TO D DO
   $( IF((FLAG(DOT!(3*(I-1)+1),0)=0) BITAND (FLAG(DOT!(3*(I-1)+2),0) NE 0)) DO
      $( FOR J=1 TO 3 DO TURN.ON.FLAG(DOT!(3*(I-1)+J),1)
         BRND:=DOT!(3*(I-1)+2)
         TEST (STRCNSCH(BRND)=1) THEN TERMINATE(I)
                                 OR FOR K=1 TO NS DO TURN.OFF.FLAG(K,1)
      $)
   $)
$)

NRJ:=0
NDBAT:=0
NST:=0
NDB:=0
FOR I=1 TO NUMBAT DO IF ((FLAG(I,0)=0) BITAND (FLAG(I,14)=0)) DO
$( NST:=NST+1
   FOR J=1 TO 5 DO
   SCT!((NST-1)*5+J):=MBCT!(5*(I-1)+J)
$)
FOR I=1 TO NUMBAT DO IF ((FLAG(I,0)=0) BITAND (FLAG(I,14) NE 0)) DO
$( NDB:=NDB + (EQCLSC!I)/2
   NDBAT:=NDBAT+1
   FOR J=1 TO 5 DO
   SCT!((NST+NDBAT-1)*5+J):= MBCT!(5*(I-1)+J)
$)
FOR I=1 TO NUMBAT DO IF FLAG(I,20) NE 0 DO
$( NRJ:=NRJ+1
   FOR J=1 TO 5 DO
   SCT!(5*(NST+NDBAT+NRJ-1)+J):=MBCT!(5*(I-1)+J)
$)

FOR I=(NST+1) TO NST+NDBAT DO
$( DBCT!(3*(I-NST-1)+1):=SCT!(5*(I-1)+1)
   Q:=1
   FOR J=2 TO 5 DO IF SCT!(5*(I-1)+J) LE NUMBAT DO
   $( AT!Q:=SCT!(5*(I-1)+J)
      Q:=Q+1
   $)
   DBCT!(3*(I-NST-1)+2):=((AT!1 < AT!2) -> AT!1,AT!2)
   DBCT!(3*(I-NST-1)+3):=((AT!1 > AT!2) -> AT!1, AT!2)
$)


FREEVEC(CPERM)
FREEVEC(DOT)
FREEVEC(AT)
REDINV:=NEWVEC(P)
REVSCT:=NEWVEC(NUMBAT)
FOR I=0 TO NUMBAT DO REVSCT!I:=0
INV:=NEWVEC(P)
FOR I=0 TO P DO
$( INV!I:=0
   REDINV!I:=0
$)
KCSG:= 1<<(NDB/2)
IPERM:=NEWVEC(NUMBAT+EXTRA+1)
FOR I=0 TO (NUMBAT+EXTRA+1) DO IPERM!I:=0
NDBS:=0
FOR I=1 TO (NST+NDBAT+NRJ) DO
REVSCT!(SCT!(5*(I-1)+1)):=I
FOR K=(NUMBAT+1) TO (EXTRA+NUMBAT+1) DO
IPERM!K:=K
FOR K=1 TO P DO
$( FOR M=1 TO NUMBAT DO IPERM!(PERM!(NUMBAT*(K-1)+M)):=M
   FOR I=1 TO (NST+NDBAT+NRJ) DO
   $( IMAGE:=PERM!(NUMBAT*(K-1)+(SCT!(5*(I-1)+1)))
      AFTER:=((IPERM!(MBCT!((IMAGE-1)*5+2))-
               IPERM!(MBCT!((IMAGE-1)*5+3)))*
              (IPERM!(MBCT!((IMAGE-1)*5+2))-
               IPERM!(MBCT!((IMAGE-1)*5+4)))*
              (IPERM!(MBCT!((IMAGE-1)*5+2))-
               IPERM!(MBCT!((IMAGE-1)*5+5)))*
              (IPERM!(MBCT!((IMAGE-1)*5+3))-
               IPERM!(MBCT!((IMAGE-1)*5+4)))*
              (IPERM!(MBCT!((IMAGE-1)*5+3))-
               IPERM!(MBCT!((IMAGE-1)*5+5)))*
              (IPERM!(MBCT!((IMAGE-1)*5+4))-
               IPERM!(MBCT!((IMAGE-1)*5+5))))
      BEFORE:=((MBCT!(5*(IMAGE-1)+2)-MBCT!(5*(IMAGE-1)+3))*
              (MBCT!(5*(IMAGE-1)+2)-MBCT!(5*(IMAGE-1)+4))*
              (MBCT!(5*(IMAGE-1)+2)-MBCT!(5*(IMAGE-1)+5))*
              (MBCT!(5*(IMAGE-1)+3)-MBCT!(5*(IMAGE-1)+4))*
              (MBCT!(5*(IMAGE-1)+3)-MBCT!(5*(IMAGE-1)+5))*
              (MBCT!(5*(IMAGE-1)+4)-MBCT!(5*(IMAGE-1)+5)))
      PAR:=(AFTER/(ABS AFTER))/(BEFORE/(ABS BEFORE))
      INVTST:=((REVSCT!IMAGE)-1)
      INV!K:=INV!K BITOR (1 << INVTST)*((1-PAR)/2)
   $)
$)
FREEVEC(IPERM)

STPRMINDEX:=0
STPRMORDER:=0
FOR I=1 TO P DO
IF (((INV!I)/(1 << (NST+NDBAT))) =0) DO STPRMORDER:=STPRMORDER+1
STPRM:=NEWVEC((NST+NDBAT)*STPRMORDER)
PERMTOSTPRM:=NEWVEC(STPRMORDER)
FOR I=1 TO P DO
IF ((INV!I)/(1 << (NST+NDBAT)) =0) DO
$( STPRMINDEX:=STPRMINDEX+1
   DBINDEX:=NST
   INDEX:=0
   FOR J=1 TO NUMBAT DO
   IF (FLAG(J,0)=0) DO
   TEST (FLAG(PERM!(NUMBAT*(I-1)+J),14) NE 0) THEN
   $( DBINDEX:=DBINDEX+1
      STPRM!((NST+NDBAT)*(STPRMINDEX-1)+DBINDEX):=REVSCT!(PERM!(NUMBAT*(I-1)+J))
   $)
   OR
   $( INDEX:=INDEX+1
      STPRM!((NST+NDBAT)*(STPRMINDEX-1)+INDEX):=REVSCT!(PERM!(NUMBAT*(I-1)+J))
   $)
   REDINV!STPRMINDEX:=(INV!I REM (1<<(NST+NDBAT)))
   PERMTOSTPRM!STPRMINDEX:=NUMBAT*(I-1)+1
$)
FOR I=NUMBAT+1 TO NS-1 BY 2 DO
$( FOR K=2 TO 3 DO
   IF (FLAG(MBCT!(5*(I-1)+K),6) NE 0) DO
   $( TURN.ON.FLAG(MBCT!(5*(I-1)+2),8)
      TURN.ON.FLAG(MBCT!(5*(I-1)+3),8)
   $)
   K:=(MBCT!(5*(I-1)+2)>MBCT!(5*(I-1)+3) ->
         MBCT!(5*(I-1)+2),MBCT!(5*(I-1)+3))
   TURN.ON.FLAG(K,7)
$)
TEST (NDB NE 0) THEN
$( STATIC $(  GD=NIL; CD=NIL; BD=NIL; $)
   INVGEN:=NEWVEC((NDB/2)+1)
   DINVGEN:=NEWVEC(NDB/2)
   MMINVGEN:=NEWVEC((NDB/2)+1)
   FOR I=0 TO ((NDB/2)+1) DO
   $( INVGEN!I:=0
      MMINVGEN!I:=0
   $)
   FOR I=0 TO (NDB/2) DO DINVGEN!I:=0
   J:=0
   NDBS:=0
   FOR I=(NUMBAT+1) TO (NS-1) BY 2 DO
   IF (FLAG(MBCT!((I-1)*5 +2),0) = 0) DO
   $( J:=J+1
      INVGEN!J:=(1<<(REVSCT!(MBCT!(5*(I-1) + 2))-1)) BITOR 
                (1<<(REVSCT!(MBCT!(5*(I-1)+3))-1))
      TEST (FLAG(MBCT!(5*(I-1)+2),8) NE 0) THEN
      $( NDBS:=NDBS+1
         DINVGEN!NDBS:=INVGEN!J
      $)
      OR MMINVGEN!J:=INVGEN!J
   $)
RDBINV:=NEWVEC(1<<NDBS)
DBINV:=NEWVEC(KCSG)
   FOR I=0 TO (1<<NDBS) DO RDBINV!I:=0
   FOR I=0 TO KCSG DO DBINV!I:=0
   FOR I=0 TO ((1<<NDBS)-1) DO
   FOR J=1 TO NDBS DO
   $( CD:=1<<(J-1)
      GD:=I BITAND CD
      BD:=(GD/CD)*DINVGEN!J
      RDBINV!(I+1):=(RDBINV!(I+1) NEQV BD)
   $)
   FOR I=0 TO ((1<<(NDB/2))-1) DO
   FOR J=1 TO (NDB/2) DO
   $( CD:=1<<(J-1)
      GD:=I BITAND CD
      BD:=(GD/CD)*(INVGEN!J)
      DBINV!(I+1):=(DBINV!(I+1) NEQV BD)
   $)
$)
OR                  $( RDBINV:=NEWVEC(1)
                     DBINV:=NEWVEC(1)
                     RDBINV!1:=0
                     DBINV!1:=0
                     $)
IF ((NDB NE 0) BITOR (NST NE 0)) DO
$(T
 PRODPERM:=NEWVEC(NST+NDBAT)
ORB:=NEWVEC(NST+NDBAT)
REFLCHK:=NEWVEC(NST+NDBAT)
ORBCOUNT:=NEWVEC(NST+NDBAT)

POLYASUM:=0
STEREOCOUNT:=0
FOR I=1 TO STPRMORDER DO
$( POLYACOEF:=0
   SUM:=0
   FOR J=1 TO (NST+NDBAT) DO
   $( ORB!J:=J
      PRODPERM!J:=J
   $)
   $( OLDSUM:=SUM
      SUM:=0
      FOR J=1 TO (NST+NDBAT) DO
      $( PRODPERM!J:=STPRM!((NST+NDBAT)*(I-1)+PRODPERM!J)
         ORB!J:=(ORB!(PRODPERM!J) < ORB!(STPRM!((NST+NDBAT)*(I-1)+PRODPERM!J))->
                ORB!(PRODPERM!J),ORB!(STPRM!((NST+NDBAT)*(I-1)+PRODPERM!J)))
        SUM:=SUM+ORB!J
      $)
   $)
   REPEATUNTIL SUM=OLDSUM
   FOR I=0 TO NST+NDBAT DO
   $( REFLCHK!I:=0
      ORBCOUNT!I:=0
   $)
   NUMORBS:=0
   FOR J=1 TO NST+NDBAT DO
   $( IF ((ORBCOUNT!(ORB!J)=0) BITAND ((ORB!J) NE 0)) DO
      $( ORBCOUNT!(ORB!J):=-1
         NUMORBS:=NUMORBS+1
      $)
      A:=1<<(J-1)
      IF ((A BITAND REDINV!I) NE 0) DO
      REFLCHK!(ORB!J):=NOT(REFLCHK!(ORB!J))
   $)
   REFLCHKSUM:=0
   FOR J=1 TO NST DO
   REFLCHKSUM:=REFLCHKSUM+REFLCHK!J
   IF REFLCHKSUM=0 DO
   $( FOR K=1 TO (1<<(NDB/2)) DO
      $( FOR M=0 TO NST+NDBAT DO REFLCHK!M:=0
         FOR J=NST+1 TO NST+NDBAT DO
         $( A:=1<<(J-1)
            M:=((REDINV!I) NEQV (DBINV!K))
            IF ((A BITAND M) NE 0) DO
            REFLCHK!(ORB!J):=NOT(REFLCHK!(ORB!J))
         $)
         REFLCHKSUM:=0
         FOR J=NST+1 TO NST+NDBAT DO
         REFLCHKSUM:=REFLCHKSUM+REFLCHK!J
         IF (REFLCHKSUM=0) DO POLYACOEF:=POLYACOEF+1
      $)
      POLYASUM:=POLYASUM+POLYACOEF*(1<<NUMORBS)
   $)
$)
STEREOCOUNT:=POLYASUM/((1<<(NDB/2))*STPRMORDER)
NEWLINE(1)
OUTS("STEREOCOUNT=")
OUTNO(STEREOCOUNT)
FREEVEC(ORBCOUNT)
FREEVEC(REFLCHK)
FREEVEC(ORB)
FREEVEC(PRODPERM)
$)T
FREEVEC(DBINV)
IF (NEXTNUMBAT>0) DO
$(   IF ((NDB=0) BITAND (NST=0)) DO 
   $( STEREOCOUNT:=1
   NEWLINE(1)
   OUTS("STEREOCOUNT=")
   OUTNO(STEREOCOUNT)
   $)
 OUTS(" FOR #")
   OUTNO(STRUCNUM)
   TOTALCOUNT:=TOTALCOUNT+STEREOCOUNT
   OUTS(" TOTAL=")
   OUTNO(TOTALCOUNT)
   FREEVEC(RDBINV);
   IF (NDB NE 0) DO $( FREEVEC(MMINVGEN); FREEVEC(DINVGEN); FREEVEC(INVGEN); $)
   FREEVEC(PERMTOSTPRM); FREEVEC(STPRM); FREEVEC(INV);
   FREEVEC(REVSCT); FREEVEC(REDINV)
FREEVEC(ORBIT)
FREEVEC(SCT)
FREEVEC(DBCT)
FREEVEC(MBCT)
FREEVEC(CTF)
FREEVEC(MULTEDG)
FREEVEC(EQCLSC)
FREEVEC(CUMULENE)
FREEVEC(PERM)
FREEVEC(ATYPSTK)
FREEVEC(ATTYPE)
FREEVEC(NHYD)
FREEVEC(CT)
   GOTO GENEND
$)
TEST ((NDB NE 0) BITOR (NST NE 0)) THEN
$(T
 MAXISOM:=(((1<<(NST+NDBAT+1))/R2WDSZ)+1)
   D:=NEWVEC(MAXISOM)
   GENCONSTR:=NEWVEC(INWDSZ)
   GPSTR:=P/(R2WDSZ/2)
   IF ((P REM (R2WDSZ/2)) NE 0 ) DO
   GPSTR:=GPSTR+1
   GPSTR:=GPSTR+2
   IF (STEREOCOUNT*GPSTR>3072) DO
   $( ENDREAD(INPUT)
      NEWLINE(1)
      OUTS("THERE ARE TOO MANY STEREOISOMERS TO GENERATE")
      NEWLINE(1)
      GOTO GENEND
   $)
   ISOMERS:=NEWVEC(STEREOCOUNT*GPSTR)
   FOR I=0 TO STEREOCOUNT*GPSTR DO ISOMERS!I:=0
   SUM:=0
   NEQCL:=0
   FOR I=0 TO MAXISOM DO D!I:=ALLON
    FOR I=0 TO INWDSZ DO GENCONSTR!I:=0
   MOST:=(1<<(NST+NDBAT))-1
   FOR I=1 TO NST+NDBAT DO
   IF (FLAG(SCT!(5*(I-1)+1),7) NE 0) DO
   GENCONSTR!(I/R2WDSZ):=GENCONSTR!(I/R2WDSZ) BITOR (1<<((I REM R2WDSZ)-1))
   FOR K=0 TO MOST DO
   $(K UNTIL ((K BITAND GENCONSTR!0)=0) DO
      $( SKIP:=(K BITAND GENCONSTR!0)
         K:=K+SKIP
         IF (K>MOST) DO BREAK
      $)
      IF (K>MOST) DO BREAK
      G:=(D!(K/R2WDSZ))
      TEST  ((G BITAND (1<<(K REM R2WDSZ))) NE 0)
      THEN W:=K
      OR LOOP
      S14: NEQCL:=NEQCL+1
      ISOMERS!(GPSTR*(NEQCL-1)+1):=W
      LARGEST.SO.FAR:=W
      ENANTIOMER:=INVERT(W)
      FOR J=1 TO STPRMORDER DO
      $(J FOR M=1 TO (1<<NDBS) DO
         $(M WP:= W NEQV RDBINV!M
            STM:=0
            FOR I=1 TO NST+NDBAT DO
            $( B:=1<<(I-1)
               C:=(1<<(STPRM!((NST+NDBAT)*(J-1)+I)-1))
               TEST ((REDINV!J BITAND C) NE 0)
               THEN T:=((((B BITAND WP)/B)+1) REM 2)*C
               OR T:=((B BITAND WP)/B)*C
               STM:=STM BITOR T
            $)
            MIN.MAX(STM)
            LARGEST.SO.FAR:=(LARGEST.SO.FAR > STMAX -> LARGEST.SO.FAR,STMAX)
            IF STMIN=W DO
            ISOMERS!(GPSTR*(NEQCL-1)+3+(2*(J-1))/R2WDSZ):=
            ISOMERS!(GPSTR*(NEQCL-1)+3+(2*(J-1))/R2WDSZ) BITOR (1<<(2*(J-1) REM R2WDSZ))
            IF STMAX=ENANTIOMER DO
            $( ISOMERS!(GPSTR*(NEQCL-1)+2):=1
               ISOMERS!(GPSTR*(NEQCL-1)+3+(2*(J-1))/R2WDSZ):=
               ISOMERS!(GPSTR*(NEQCL-1)+3+(2*(J-1))/R2WDSZ) BITOR (2<<(2*(J-1) REM R2WDSZ))
            $)
            IF ((STM=W) BITAND (STMIN NE W))  DO
            ISOMERS!(GPSTR*(NEQCL-1)+3+(2*(J-1))/R2WDSZ):=
            ISOMERS!(GPSTR*(NEQCL-1)+3+(2*(J-1))/R2WDSZ) BITOR (1<<(2*(J-1) REM R2WDSZ))
            H:= ALLBUTONEON ROTL (STM REM R2WDSZ)
            D!(STM/R2WDSZ):=D!(STM/R2WDSZ) BITAND H
            H:= ALLBUTONEON ROTL (STMIN REM R2WDSZ)
            D!(STMIN/R2WDSZ):=D!(STMIN/R2WDSZ) BITAND H
         $)M
      $)J
      IF ((ISOMERS!(GPSTR*(NEQCL-1)+2) =0) BITAND (ENAN=0)) DO
      $( W:= INVERT(LARGEST.SO.FAR)
         ENAN:=1
         GOTO S14
      $)
      ENAN:=0
   $)K
ENDREAD(INPUT)
INPUT:=TTY
FOUND:=NEWVEC(NUMBAT)
MAKESCAT(NEWVEC(200),200,NEWVEC(400),400)
S5: NEWLINE(1)
 SWITCHON PROMPTSELECT("ST>",0,[TABLE 2,
                      "PROJECT NEWMAN CONFIGS SYMGROUP",
                      "EQUIVATOMS LIST SEGMENT DONE"],
                      "STEREO-HELP",[TABLE 8,"PROJECT",1,"NEWMAN",2,
                      "CONFIGS",3,"SYMGROUP",4,"EQUIVATOMS",5,"LIST",6,
                      "DONE",7,"SEGMENT",8,0],TRUE) INTO
$(    CASE 1: 
        C1S1:  ISO:=GETNONNEGINT("STEREOISOMER NUMBER: ","STEREO-HELP",0)
           IF (ISO<0) DO GOTO EC1
          IF (CHKISOMNUM(ISO)=0) DO $( NEWLINE(1); GOTO C1S1; $)
     C1S2:   CENT:=GETPOSINT("STEREOCENTER NUMBER: ","STEREO-HELP",0)
           IF (CENT<1) DO GOTO EC1
           IF (FLAG(CENT,0) NE 0) DO
           $( NEWLINE(1)
              OUTNO(CENT)
              OUTS(" IS NOT A STEREOCENTER")
              SHOWCONFIGS(ISO)
              NEWLINE(1)
              GOTO C1S2
           $)
          TEST (FLAG(CENT,14)=0)
           THEN DRAWSTEREOCENTER(ISO,CENT)
           OR   DRAWDOUBLEBOND(ISO,CENT)
     EC1:   ENDCASE
   CASE 2:
       C2S1:  ISO:=GETNONNEGINT("STEREOISOMER NUMBER: ","STEREO-HELP",0)
         IF (ISO<0) DO GOTO EC2
        IF (CHKISOMNUM(ISO)=0) DO $( NEWLINE(1); GOTO C2S1; $)
    C2S2:   CNTF:=GETPOSINT("FRONT STEREOCENTER: ","STEREO-HELP",0)
         IF (CNTF<1) DO GOTO EC2
         IF ((FLAG(CNTF,0) NE 0) BITOR (FLAG(CNTF,14) NE 0)) DO
           $( NEWLINE(1)
              OUTNO(CNTF)
              OUTS(" IS NOT A TETRAHEDRAL STEREOCENTER, CHOOSE ONE OF: ")
              NEWLINE(1)
               FOR I=1 TO NST DO
               $( OUTS(" ")
                  OUTNO(SCT!(5*(I-1)+1))
               $)
              NEWLINE(1)
              GOTO C2S2
            $)
    C2S3:   CNTB:=GETPOSINT("REAR STEREOCENTER: ","STEREO-HELP",0)
         IF (CNTB<1) DO GOTO EC2
         ADJCHK:=0
          FOR J=2 TO 5 DO
          IF (MBCT!(5*(CNTF-1)+J)=CNTB) DO ADJCHK:=1
         IF ((FLAG(CNTB,0) NE 0) BITOR (FLAG(CNTB,14) NE 0) BITOR (ADJCHK=0)) DO
         $( NEWLINE(1)
             OUTNO(CNTB)
             OUTS(" IS NOT A TETRAHEDRAL STEREOCENTER ADJACENT TO ")
             OUTNO(CNTF)
             OUTS(".  CHOOSE ONE OF: ")
             NEWLINE(1)
             FOR J=2 TO 5 DO
             $( POSADJ:=SCT!(5*(REVSCT!CNTF-1)+J)
                IF ((FLAG(POSADJ,0)=0) BITAND (FLAG(POSADJ,14)=0)) DO
                $( OUTS(" ")
                   OUTNO(POSADJ)
                $)
              $)
              NEWLINE(1)
            GOTO C2S3
           $)
           NEWMANPROJ(ISO,CNTF,CNTB)
    EC2:   ENDCASE
   CASE 3: 
       C3S1: ISO:=GETNONNEGINT("STEREOISOMER NUMBER: ","STEREO-HELP",0)
         IF (ISO<0) DO GOTO EC3
        IF (CHKISOMNUM(ISO)=0) DO 
        $( NEWLINE(1)
           GOTO C3S1
       $)
           SHOWCONFIGS(ISO)
     EC3:   ENDCASE
   CASE 4: 
       C4S1: ISO:=GETNONNEGINT("STEREOISOMER NUMBER: ","STEREO-HELP",0)
         IF (ISO<0) DO GOTO EC4
         IF (CHKISOMNUM(ISO)=0) DO 
         $( NEWLINE(1)
            GOTO C4S1
       $)
           SYMGROUPFOR(ISO)
    EC4:    ENDCASE
   CASE 5: 
     C5S1: ISO:=GETNONNEGINT("STEREOISOMER NUMBER: ","STEREO-HELP",0)
         IF (ISO<0) DO GOTO EC5
          IF (CHKISOMNUM(ISO)=0) DO 
          $( NEWLINE(1)
             GOTO C5S1
         $)
           COMPEQUIVATOMS(ISO)
     EC5:   ENDCASE
   CASE 6:   FOR I=1 TO STEREOCOUNT DO
         $(     OUTNO(ISOMERS!(GPSTR*(I-1)+1))
               TEST (ISOMERS!(GPSTR*(I-1)+2)=0) THEN OUTS("C")
                                                  OR   OUTS("A")
               OUTS(" ")
             IF ((I REM 15)=0) DO NEWLINE(1)
             $)
             ENDCASE
   CASE 7: GOTO S6
           ENDCASE
   CASE 8: CHNPAR:=NEWVEC(20)
           CHNDR:=NEWVEC(40)
           CHN:=NEWVEC(20)
           TOPR:=NEWVEC(20)
           BOTR:=NEWVEC(20)
        FOR I=1 TO 20 DO
           $( CHNDR!I:=0
              CHN!I:=0
              TOPR!I:=0
              CHNDR!(I+20):=0
              BOTR!I:=0
              CHNPAR!I:=0
           $)
     C8S1:   CHLN:=GETPOSINT("HOW LONG? ","STERE0-HELP",0)
         IF (CHLN<0) DO GOTO S1
         IF (CHLN>20) DO
           $( NEWLINE(1)
              OUTS("SEGMENT TOO LONG, TYPE A NUMBER FROM 1 TO 20")
              NEWLINE(1)
              GOTO C8S1
           $)
           FOR I=1 TO CHLN DO 
           $( CHN!I:=GETPOSINT("LIST ATOM NUMBERS: ","STEREO-HELP",0)
            IF (CHN!I<0) DO GOTO S1 $)
           DETCHAIN(CHLN)
      S2:  NEWLINE(1)
           ISO:=GETNONNEGINT("STEREOISOMER NUMBER: ","STEREO-HELP",0)
           IF (ISO<0) DO GOTO S1
           IF (CHKISOMNUM(ISO)=0) DO GOTO S2
           DRAWCHAIN(ISO,CHLN)
           GOTO S2
      S1:  FREEVEC(BOTR)
           FREEVEC(TOPR)
           FREEVEC(CHN)
           FREEVEC(CHNDR)
           FREEVEC(CHNPAR)
           ENDCASE
$)
GOTO S5
S6: OUTS("NO FURTHER INFORMATION REQUESTED")
NEWLINE(1)
$)T
OR $( NEQCL:=1
      NEWLINE(1)
      OUTS("STEREOCOUNT=1")
      IF (NEXTNUMBAT<0) DO NEWLINE(1)
      IF (NEXTNUMBAT>0) DO
      $( OUTS(" FOR #")
         OUTNO(STRUCNUM)
         TOTALCOUNT:=TOTALCOUNT+1
         OUTS(" TOTAL=")
         OUTNO(TOTALCOUNT)
      $)
   ENDREAD(INPUT)
   $)
GENEND:

$)D

LET START() BE
$( INITIALISEIO(VECSPACE,6000)
   RECINIT()
   OUTPUT:=TTY
   INPUT:=FINDFILE("DSK",SC1FILENAME(),CGEXT)
   READRETURN()
STO:    GETCTANDGROUP()
   IF (GPTOOLG=1) DO GOTO CGN
      GENERATE()
   IF (NEXTNUMBAT>0) DO GOTO STO
CGN:  EXECUTERETURN()
  
  
$)
